home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / BACKUP / FWKC13R.ZIP;1 / FWKC13R.BAS < prev    next >
Encoding:
BASIC Source File  |  1992-11-25  |  5.4 KB  |  92 lines
  1. 10 ON ERROR GOTO 810
  2. 20 CLS:LOCATE 16,50:PRINT "W A R N I N G"
  3. 30 LOCATE 18,50:PRINT "This is a DELETION program."
  4. 40 LOCATE 1,1:PRINT "FWKC13R(TM) Column 13 'd' or 'm' for Removal. Ver. 0.10. 1991 Nov 25."
  5. 50 PRINT "(C)Copyright Frederick W. Kantor 1988-1992. All rights reserved.
  6. 60 PRINT "Your use of this program is at solely your own risk: PLEASE HAVE PROPER BACKUPS"
  7. 70 PRINT STRING$(24,"-") " C A V E A T   O P E R A T O R " STRING$(24,"-")
  8. 80 LOCATE 6,1:PRINT "This program looks in column 13 of a sorted text directory for"
  9. 90 PRINT "lower_case 'd' or 'm':  'd' is for deletion.  'm' is for moving the file."
  10. 100 PRINT "If it finds 'd' or 'm', then it appends the text line to a .DEL file,"
  11. 110 PRINT "  searches DIRGUIDE.TXT for where the file is, deletes or moves the file,"
  12. 120 PRINT "  and appends that file's d:\path\filename.ext to DELETED.LST."
  13. 130 PRINT "The original text directory file is saved with the extension '.OLD'."
  14. 140 PRINT "A new text directory file is created, not listing the deleted or moved file(s)."
  15. 150 PRINT "Multiline descriptions can be processed."
  16. 160 PRINT "Filenames not found in DIRGUIDE.TXT, or on drive, are appended to MISSED."
  17. 170 LOCATE 16,4:PRINT "Lines read:":LOCATE 17,1:PRINT "Files deleted:"
  18. 180 LOCATE 18,3:PRINT "Files moved:"
  19. 190 LOCATE 21,1:INPUT "Name of text directory to process = ",INFILE$
  20. 200 IF LEN(INFILE$)=0 THEN GOTO 190 ELSE IF INSTR(INFILE$,".")>0 THEN GOTO 800
  21. 210 OPEN INFILE$ FOR INPUT AS 1:CLOSE 1
  22. 220 LOCATE 22,1:INPUT "d:\path of where to put 'm' files = ",TD$
  23. 230 IF LEN(TD$)=0 THEN GOTO 220
  24. 240 FOR I=1 TO LEN(TD$):SC$=MID$(TD$,I,1)
  25. 250 IF SC$>="a" AND SC$<="z" THEN SC$=CHR$(ASC(SC$)-32):MID$(TD$,I,1)=SC$
  26. 260 NEXT I
  27. 270 IF (RIGHT$(TD$,1)="\")AND(RIGHT$(TD$,2)<>":\") THEN TD$=LEFT$(TD$,LEN(TD$)-1)
  28. 280 TS$=TD$:IF RIGHT$(TS$,1)<>"\" THEN TS$=TS$+"\"
  29. 290 TP$=TS$+"@!@#$#@!.TMP":OPEN TP$ AS 1 LEN=1:CLOSE 1:KILL TP$
  30. 300 OPEN "DIRGUIDE.TXT" FOR INPUT AS 1:CLOSE 1
  31. 310 OPEN INFILE$ FOR INPUT AS 1:OPEN INFILE$+".TMP" FOR OUTPUT AS 2
  32. 320 OPEN "##NAMES.TMP" FOR OUTPUT AS 3:OPEN INFILE$+".DEL" FOR APPEND AS 4
  33. 330 D=0:F=0:I=0:WHILE NOT EOF(1):LINE INPUT #1,A$
  34. 340 I=I+1:LOCATE 16,18:PRINT USING "########";I
  35. 350 IF LEFT$(A$,1)>" " THEN F=0
  36. 360 IF F=1 THEN PRINT #4,A$:GOTO 400
  37. 370 S$=MID$(A$,13,1):IF (LEFT$(A$,1)>" ")AND(S$="d" OR S$="m") THEN F=1:PRINT #3,LEFT$(A$,13):PRINT #4,A$:GOTO 400
  38. 380 IF LEFT$(A$,1)>" " THEN NFILES=NFILES+1:W#=W#+VAL(MID$(A$,14,9))
  39. 390 PRINT #2,A$
  40. 400 WEND:CLOSE
  41. 410 OPEN "##NAMES.TMP" FOR INPUT AS 1:OPEN "DIRGUIDE.TXT" FOR INPUT AS 2
  42. 420 OPEN "DELETED.LST" FOR APPEND AS 3
  43. 430 B$="":WHILE NOT EOF(1):LINE INPUT #1,A$
  44. 440 IF LEFT$(A$,12)>LEFT$(B$,12) THEN LINE INPUT #2,B$:GOTO 440
  45. 450 IF LEFT$(A$,12)<LEFT$(B$,12) THEN GOSUB 780:GOTO 560
  46. 460 IF MID$(B$,15,1)<>":" THEN LINE INPUT #2,B$:GOTO 450
  47. 470 X$=LEFT$(B$,12):GOSUB 600:C$=MID$(B$,14)+X$
  48. 480 IF RIGHT$(A$,1)="d" THEN KILL C$:PRINT #3,C$ "  deleted":D=D+1:LOCATE 17,18:PRINT USING "########";D:GOTO 560
  49. 490 OPEN C$ FOR INPUT AS 4:Q1#=LOF(4):CLOSE 4
  50. 500 TT$=TS$+X$:LOCATE 19,1:SHELL "COPY "+C$+" "+TT$
  51. 510 OPEN TT$ AS 4 LEN=1:Q2#=LOF(4):CLOSE 4
  52. 520 IF Q1#=Q2# THEN KILL C$:PRINT #3,C$ "  moved to  " TT$:E=E+1:LOCATE 18,18:PRINT USING "########";E:GOTO 560
  53. 530 PRINT #3,C$ " filename removed from text directory, but file not deleted"
  54. 540 OPEN "BADMOVE" FOR APPEND AS 4
  55. 550 PRINT #4,"failed to move " C$ " to " TT$:CLOSE 4
  56. 560 WEND:LD#=LOF(3):CLOSE:KILL "##NAMES.TMP"
  57. 570 IF LD#<3 THEN KILL "DELETED.LST"
  58. 580 DT$="MISSED":GOSUB 760:DT$="BADMOVE":GOSUB 760
  59. 590 GOSUB 620:LOCATE 22,1:SYSTEM
  60. 600 IF RIGHT$(X$,1)=" " THEN X$=LEFT$(X$,LEN(X$)-1):GOTO 600
  61. 610 RETURN
  62. 620 ' subroutine for revising file_header
  63. 630 OPEN INFILE$+".TMP" FOR INPUT AS 2:OPEN INFILE$+".TP2" FOR OUTPUT AS 3
  64. 640 PP$="########,###":T$=DATE$:IF LEN(T$)<10 THEN T$=SPACE$(10-LEN(T$))+T$
  65. 650 T$=LEFT$(T$,6)+RIGHT$(T$,2)
  66. 660 WHILE NOT EOF(2):LINE INPUT #2,B$
  67. 670 P=INSTR(B$,"Total Files:"):IF P>0 THEN GOSUB 730:GOTO 700
  68. 680 P=INSTR(B$,"Last updated on:"):IF P>0 THEN GOSUB 740:GOTO 700
  69. 690 PRINT #3,B$
  70. 700 WEND:CLOSE 2,3:KILL INFILE$+".TMP"
  71. 710 OPEN INFILE$+".OLD" AS 2 LEN=1:CLOSE 2:KILL INFILE$+".OLD"
  72. 720 NAME INFILE$ AS INFILE$+".OLD":NAME INFILE$+".TP2" AS INFILE$:RETURN
  73. 730 B$=LEFT$(B$,P+11):PRINT #3,B$;:PRINT #3,USING PP$;NFILES:RETURN
  74. 740 MID$(B$,P+17,10)=T$:P=INSTR(B$,"Total Bytes:")
  75. 750 B$=LEFT$(B$,P+11):PRINT #3,B$;:PRINT #3,USING PP$;W#:RETURN
  76. 760 CLOSE 4:OPEN DT$ AS 4 LEN=1:L4#=LOF(4):CLOSE 4:IF L4#<3 THEN KILL DT$
  77. 770 RETURN
  78. 780 CLOSE 4:OPEN "MISSED" FOR APPEND AS 4
  79. 790 PRINT #4,LEFT$(A$,12) " not found in DIRGUIDE.TXT":CLOSE 4:RETURN
  80. 800 PRINT "Period '.', found in filename, would conflict with renaming used herein.":SYSTEM
  81. 810 ' error routines for missing files, missing path, etc.
  82. 820 IF (ERR=53)AND(ERL=210) THEN PRINT "File not found:  " INFILE$:SYSTEM
  83. 830 IF (ERR=53)AND(ERL=300) THEN PRINT "DIRGUIDE.TXT not found in this current directory. Execution aborted.":SYSTEM
  84. 840 IF (ERR=53)AND(ERL=480 OR ERL=490) THEN CLOSE 4:OPEN "MISSED" FOR APPEND AS 4:PRINT #4,C$ " not found on drive":CLOSE 4:RESUME 560
  85. 850 IF (ERR=76)AND(ERL=210) THEN PRINT "Path not found:  " INFILE$:SYSTEM
  86. 860 IF (ERR=76)AND(ERL=290) THEN PRINT "Path not found:  " TD$:SYSTEM
  87. 870 PRINT "Error number =" ERR:PRINT "Error line =" ERL
  88. 880 PRINT "First write down the error number and error line, above."
  89. 890 PRINT "Then, press any alphameric key for further description..."
  90. 900 X$=INPUT$(1)
  91. 910 ON ERROR GOTO 0
  92.